<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns="http://www.w3.org/1999/xhtml"><head><link rel="stylesheet" type="text/css" href="style.css" /><script type="text/javascript" src="highlight.js"></script></head><body><pre><span class="hs-pragma">{-# LANGUAGE NoImplicitPrelude #-}</span><span>
</span><span id="line-2"></span><span class="hs-pragma">{-# LANGUAGE Unsafe #-}</span><span>
</span><span id="line-3"></span><span class="hs-pragma">{-# OPTIONS_HADDOCK not-home #-}</span><span>
</span><span id="line-4"></span><span>
</span><span id="line-5"></span><span class="hs-comment">-----------------------------------------------------------------------------</span><span>
</span><span id="line-6"></span><span class="hs-comment">-- |</span><span>
</span><span id="line-7"></span><span class="hs-comment">-- Module      :  Control.Monad.ST.Imp</span><span>
</span><span id="line-8"></span><span class="hs-comment">-- Copyright   :  (c) The University of Glasgow 2001</span><span>
</span><span id="line-9"></span><span class="hs-comment">-- License     :  BSD-style (see the file libraries/base/LICENSE)</span><span>
</span><span id="line-10"></span><span class="hs-comment">-- </span><span>
</span><span id="line-11"></span><span class="hs-comment">-- Maintainer  :  libraries@haskell.org</span><span>
</span><span id="line-12"></span><span class="hs-comment">-- Stability   :  experimental</span><span>
</span><span id="line-13"></span><span class="hs-comment">-- Portability :  non-portable (requires universal quantification for runST)</span><span>
</span><span id="line-14"></span><span class="hs-comment">--</span><span>
</span><span id="line-15"></span><span class="hs-comment">-- This library provides support for /strict/ state threads, as</span><span>
</span><span id="line-16"></span><span class="hs-comment">-- described in the PLDI \'94 paper by John Launchbury and Simon Peyton</span><span>
</span><span id="line-17"></span><span class="hs-comment">-- Jones /Lazy Functional State Threads/.</span><span>
</span><span id="line-18"></span><span class="hs-comment">--</span><span>
</span><span id="line-19"></span><span class="hs-comment">-----------------------------------------------------------------------------</span><span>
</span><span id="line-20"></span><span>
</span><span id="line-21"></span><span class="hs-keyword">module</span><span> </span><span class="hs-identifier">Control.Monad.ST.Imp</span><span> </span><span class="hs-special">(</span><span>
</span><span id="line-22"></span><span>        </span><span class="annot"><span class="hs-comment">-- * The 'ST' Monad</span></span><span>
</span><span id="line-23"></span><span>        </span><span class="annot"><a href="GHC.ST.html#ST"><span class="hs-identifier">ST</span></a></span><span class="hs-special">,</span><span>             </span><span class="hs-comment">-- abstract, instance of Functor, Monad, Typeable.</span><span>
</span><span id="line-24"></span><span>        </span><span class="annot"><a href="GHC.ST.html#runST"><span class="hs-identifier">runST</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-25"></span><span>        </span><span class="annot"><a href="Control.Monad.ST.Imp.html#fixST"><span class="hs-identifier">fixST</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-26"></span><span>
</span><span id="line-27"></span><span>        </span><span class="annot"><span class="hs-comment">-- * Converting 'ST' to 'Prelude.IO'</span></span><span>
</span><span id="line-28"></span><span>        </span><span class="annot"><a href="../../ghc-prim/src/GHC.Prim.html#RealWorld"><span class="hs-identifier">RealWorld</span></a></span><span class="hs-special">,</span><span>              </span><span class="hs-comment">-- abstract</span><span>
</span><span id="line-29"></span><span>        </span><span class="annot"><a href="GHC.IO.html#stToIO"><span class="hs-identifier">stToIO</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-30"></span><span>
</span><span id="line-31"></span><span>        </span><span class="annot"><span class="hs-comment">-- * Unsafe operations</span></span><span>
</span><span id="line-32"></span><span>        </span><span class="annot"><a href="GHC.ST.html#unsafeInterleaveST"><span class="hs-identifier">unsafeInterleaveST</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-33"></span><span>        </span><span class="annot"><a href="GHC.ST.html#unsafeDupableInterleaveST"><span class="hs-identifier">unsafeDupableInterleaveST</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-34"></span><span>        </span><span class="annot"><a href="GHC.IO.html#unsafeIOToST"><span class="hs-identifier">unsafeIOToST</span></a></span><span class="hs-special">,</span><span>
</span><span id="line-35"></span><span>        </span><span class="annot"><a href="GHC.IO.html#unsafeSTToIO"><span class="hs-identifier">unsafeSTToIO</span></a></span><span>
</span><span id="line-36"></span><span>    </span><span class="hs-special">)</span><span> </span><span class="hs-keyword">where</span><span>
</span><span id="line-37"></span><span>
</span><span id="line-38"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.ST.html"><span class="hs-identifier">GHC.ST</span></a></span><span>           </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.ST.html#ST"><span class="hs-identifier">ST</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.ST.html#runST"><span class="hs-identifier">runST</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.ST.html#unsafeInterleaveST"><span class="hs-identifier">unsafeInterleaveST</span></a></span><span>
</span><span id="line-39"></span><span>                        </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.ST.html#unsafeDupableInterleaveST"><span class="hs-identifier">unsafeDupableInterleaveST</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-40"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.Base.html"><span class="hs-identifier">GHC.Base</span></a></span><span>         </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="../../ghc-prim/src/GHC.Prim.html#RealWorld"><span class="hs-identifier">RealWorld</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Base.html#%24"><span class="hs-operator">($)</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.Base.html#return"><span class="hs-identifier">return</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-41"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.IO.html"><span class="hs-identifier">GHC.IO</span></a></span><span>           </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.IO.html#stToIO"><span class="hs-identifier">stToIO</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.IO.html#unsafeIOToST"><span class="hs-identifier">unsafeIOToST</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.IO.html#unsafeSTToIO"><span class="hs-identifier">unsafeSTToIO</span></a></span><span>
</span><span id="line-42"></span><span>                        </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.IO.Unsafe.html#unsafeDupableInterleaveIO"><span class="hs-identifier">unsafeDupableInterleaveIO</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-43"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="GHC.MVar.html"><span class="hs-identifier">GHC.MVar</span></a></span><span>         </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.MVar.html#readMVar"><span class="hs-identifier">readMVar</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.MVar.html#putMVar"><span class="hs-identifier">putMVar</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.MVar.html#newEmptyMVar"><span class="hs-identifier">newEmptyMVar</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-44"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="Control.Exception.Base.html"><span class="hs-identifier">Control.Exception.Base</span></a></span><span>
</span><span id="line-45"></span><span>                        </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="GHC.IO.html#catch"><span class="hs-identifier">catch</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.IO.html#throwIO"><span class="hs-identifier">throwIO</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="Control.Exception.Base.html#NonTermination"><span class="hs-identifier">NonTermination</span></a></span><span> </span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span>
</span><span id="line-46"></span><span>                        </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="GHC.IO.Exception.html#BlockedIndefinitelyOnMVar"><span class="hs-identifier">BlockedIndefinitelyOnMVar</span></a></span><span> </span><span class="hs-special">(</span><span class="hs-glyph">..</span><span class="hs-special">)</span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-47"></span><span>
</span><span id="line-48"></span><span class="hs-comment">-- | Allow the result of an 'ST' computation to be used (lazily)</span><span>
</span><span id="line-49"></span><span class="hs-comment">-- inside the computation.</span><span>
</span><span id="line-50"></span><span class="hs-comment">--</span><span>
</span><span id="line-51"></span><span class="hs-comment">-- Note that if @f@ is strict, @'fixST' f = _|_@.</span><span>
</span><span id="line-52"></span><span id="local-6989586621679559023"><span id="local-6989586621679559024"><span class="annot"><a href="Control.Monad.ST.Imp.html#fixST"><span class="hs-identifier hs-type">fixST</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="hs-special">(</span><span class="annot"><a href="#local-6989586621679559024"><span class="hs-identifier hs-type">a</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.ST.html#ST"><span class="hs-identifier hs-type">ST</span></a></span><span> </span><span class="annot"><a href="#local-6989586621679559023"><span class="hs-identifier hs-type">s</span></a></span><span> </span><span class="annot"><a href="#local-6989586621679559024"><span class="hs-identifier hs-type">a</span></a></span><span class="hs-special">)</span><span> </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="GHC.ST.html#ST"><span class="hs-identifier hs-type">ST</span></a></span><span> </span><span class="annot"><a href="#local-6989586621679559023"><span class="hs-identifier hs-type">s</span></a></span><span> </span><span class="annot"><a href="#local-6989586621679559024"><span class="hs-identifier hs-type">a</span></a></span></span></span><span>
</span><span id="line-53"></span><span class="hs-comment">-- See Note [fixST]</span><span>
</span><span id="line-54"></span><span id="fixST"><span class="annot"><span class="annottext">fixST :: forall a s. (a -&gt; ST s a) -&gt; ST s a
</span><a href="Control.Monad.ST.Imp.html#fixST"><span class="hs-identifier hs-var hs-var">fixST</span></a></span></span><span> </span><span id="local-6989586621679558975"><span class="annot"><span class="annottext">a -&gt; ST s a
</span><a href="#local-6989586621679558975"><span class="hs-identifier hs-var">k</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">IO a -&gt; ST s a
forall a s. IO a -&gt; ST s a
</span><a href="GHC.IO.html#unsafeIOToST"><span class="hs-identifier hs-var">unsafeIOToST</span></a></span><span> </span><span class="annot"><span class="annottext">(IO a -&gt; ST s a) -&gt; IO a -&gt; ST s a
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="hs-keyword">do</span><span>
</span><span id="line-55"></span><span>    </span><span id="local-6989586621679558974"><span class="annot"><span class="annottext">MVar a
</span><a href="#local-6989586621679558974"><span class="hs-identifier hs-var">m</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">IO (MVar a)
forall a. IO (MVar a)
</span><a href="GHC.MVar.html#newEmptyMVar"><span class="hs-identifier hs-var">newEmptyMVar</span></a></span><span>
</span><span id="line-56"></span><span>    </span><span id="local-6989586621679558973"><span class="annot"><span class="annottext">a
</span><a href="#local-6989586621679558973"><span class="hs-identifier hs-var">ans</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">IO a -&gt; IO a
forall a. IO a -&gt; IO a
</span><a href="GHC.IO.Unsafe.html#unsafeDupableInterleaveIO"><span class="hs-identifier hs-var">unsafeDupableInterleaveIO</span></a></span><span>
</span><span id="line-57"></span><span>             </span><span class="hs-special">(</span><span class="annot"><span class="annottext">MVar a -&gt; IO a
forall a. MVar a -&gt; IO a
</span><a href="GHC.MVar.html#readMVar"><span class="hs-identifier hs-var">readMVar</span></a></span><span> </span><span class="annot"><span class="annottext">MVar a
</span><a href="#local-6989586621679558974"><span class="hs-identifier hs-var">m</span></a></span><span> </span><span class="annot"><span class="annottext">IO a -&gt; (BlockedIndefinitelyOnMVar -&gt; IO a) -&gt; IO a
forall e a. Exception e =&gt; IO a -&gt; (e -&gt; IO a) -&gt; IO a
</span><a href="GHC.IO.html#catch"><span class="hs-operator hs-var">`catch`</span></a></span><span> </span><span class="hs-glyph">\</span><span class="annot"><span class="annottext">BlockedIndefinitelyOnMVar
</span><a href="GHC.IO.Exception.html#BlockedIndefinitelyOnMVar"><span class="hs-identifier hs-var">BlockedIndefinitelyOnMVar</span></a></span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-58"></span><span>                                    </span><span class="annot"><span class="annottext">NonTermination -&gt; IO a
forall e a. Exception e =&gt; e -&gt; IO a
</span><a href="GHC.IO.html#throwIO"><span class="hs-identifier hs-var">throwIO</span></a></span><span> </span><span class="annot"><span class="annottext">NonTermination
</span><a href="Control.Exception.Base.html#NonTermination"><span class="hs-identifier hs-var">NonTermination</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-59"></span><span>    </span><span id="local-6989586621679558970"><span class="annot"><span class="annottext">a
</span><a href="#local-6989586621679558970"><span class="hs-identifier hs-var">result</span></a></span></span><span> </span><span class="hs-glyph">&lt;-</span><span> </span><span class="annot"><span class="annottext">ST s a -&gt; IO a
forall s a. ST s a -&gt; IO a
</span><a href="GHC.IO.html#unsafeSTToIO"><span class="hs-identifier hs-var">unsafeSTToIO</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">a -&gt; ST s a
</span><a href="#local-6989586621679558975"><span class="hs-identifier hs-var">k</span></a></span><span> </span><span class="annot"><span class="annottext">a
</span><a href="#local-6989586621679558973"><span class="hs-identifier hs-var">ans</span></a></span><span class="hs-special">)</span><span>
</span><span id="line-60"></span><span>    </span><span class="annot"><span class="annottext">MVar a -&gt; a -&gt; IO ()
forall a. MVar a -&gt; a -&gt; IO ()
</span><a href="GHC.MVar.html#putMVar"><span class="hs-identifier hs-var">putMVar</span></a></span><span> </span><span class="annot"><span class="annottext">MVar a
</span><a href="#local-6989586621679558974"><span class="hs-identifier hs-var">m</span></a></span><span> </span><span class="annot"><span class="annottext">a
</span><a href="#local-6989586621679558970"><span class="hs-identifier hs-var">result</span></a></span><span>
</span><span id="line-61"></span><span>    </span><span class="annot"><span class="annottext">a -&gt; IO a
forall (m :: * -&gt; *) a. Monad m =&gt; a -&gt; m a
</span><a href="GHC.Base.html#return"><span class="hs-identifier hs-var">return</span></a></span><span> </span><span class="annot"><span class="annottext">a
</span><a href="#local-6989586621679558970"><span class="hs-identifier hs-var">result</span></a></span><span>
</span><span id="line-62"></span><span>
</span><span id="line-63"></span><span class="hs-comment">{- Note [fixST]
   ~~~~~~~~~~~~

For many years, we implemented fixST much like a pure fixpoint,
using liftST:

  fixST :: (a -&gt; ST s a) -&gt; ST s a
  fixST k = ST $ \ s -&gt;
      let ans       = liftST (k r) s
          STret _ r = ans
      in
      case ans of STret s' x -&gt; (# s', x #)

We knew that lazy blackholing could cause the computation to be re-run if the
result was demanded strictly, but we thought that would be okay in the case of
ST. However, that is not the case (see #15349). Notably, the first time
the computation is executed, it may mutate variables that cause it to behave
*differently* the second time it's run. That may allow it to terminate when it
should not. More frighteningly, Arseniy Alekseyev produced a somewhat contrived
example ( https://mail.haskell.org/pipermail/libraries/2018-July/028889.html )
demonstrating that it can break reasonable assumptions in &quot;trustworthy&quot; code,
causing a memory safety violation. So now we implement fixST much like we do
fixIO. See also the implementation notes for fixIO. Simon Marlow wondered
whether we could get away with an IORef instead of an MVar. I believe we
cannot. The function passed to fixST may spark a parallel computation that
demands the final result. Such a computation should block until the final
result is available.
-}</span><span>
</span><span id="line-91"></span></pre></body></html>